home *** CD-ROM | disk | FTP | other *** search
/ Die Speccy' 97 / Die Speccy' 97.iso / amiga_system / the_aminet / comm / bbs / bbbbs85.lha / rexxDoors / Polling_Place.rexx < prev    next >
OS/2 REXX Batch file  |  1994-01-28  |  10KB  |  443 lines
  1. /* $VER: Polling_Place.rexx 6.2 (5.8.93)
  2.  a Voting Booth for BBBBS by Richard Lee Stockton
  3. */
  4.  
  5. CALL TIME('R')
  6. SIGNAL ON BREAK_C
  7. SIGNAL ON BREAK_E
  8. CR='0D'x
  9.  
  10. figarg='s:CONFIG.BBS'
  11. IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
  12. x=OPEN(f,figarg,'R')
  13. IF x=0 THEN
  14.   DO
  15.     SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
  16.     EXIT(20)
  17.   END
  18.  
  19. line=STRIP(READLN(f))
  20. sysop=WORD(READLN(f),1)
  21. CALL CLOSE(f)
  22.  
  23. compos=POS('/*',line)
  24. IF compos>0 THEN line=LEFT(line,compos-1)
  25. bbsname=STRIP(line)
  26.  
  27. bbspath=GETCLIP('BBS_path')
  28. polldir=bbspath'rexxDoors/Data/Polls'
  29. CALL MAKEDIR(polldir)
  30.  
  31. PARSE ARG name . . colorflag secs .
  32. name=STRIP(name)
  33. colorflag=STRIP(colorflag)
  34. IF ~DATATYPE(colorflag,'N') THEN colorflag=1
  35. CALL colors(colorflag)
  36. polls=SHOWDIR(polldir)
  37.  
  38. DO FOREVER
  39.   SAY CR
  40.   SAY bak2||CENTER('  -  Polling_Place.rexx  version 6.2  5 Aug 1993  -  ',75)||def||CR
  41.   CALL ShowPolls()
  42.   com=getinput(1 0 '['pen3'Q'def']uit_To_BBS, ['pen3'S'def']tart_New_Poll or Select_Poll_Number > ')
  43.   com=STRIP(com)
  44.   CALL checkBBS()
  45.   SELECT
  46.     WHEN com='S' THEN CALL InitPoll()
  47.     WHEN com='X' | com='Q' THEN
  48.       DO
  49.         SAY CR
  50.         SAY 'Returning to the BBS...'CR
  51.         SAY CR
  52.         EXIT
  53.       END
  54.     WHEN DATATYPE(com,'N') THEN CALL do_poll()
  55.     WHEN com='' THEN
  56.       IF getinput(1 1 'Return to BBS? (nY) > ')~='N' THEN EXIT
  57.     OTHERWISE NOP
  58.   END
  59. END
  60. EXIT
  61.  
  62.  
  63. checkBBS:
  64. IF ADDRESS()~='BAUD' THEN RETURN 0
  65. IF TIME('E')>secs THEN EXIT
  66. dcd
  67. IF RC=0 THEN EXIT
  68. temp=secs-TIME('E')
  69. IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR 
  70. RETURN 0
  71.  
  72.  
  73. getinput:
  74. PARSE ARG upflag' 'oneflag' 'pline
  75. OPTIONS PROMPT pline
  76. PARSE PULL inarg
  77. inarg=STRIP(inarg)
  78. IF upflag THEN inarg=UPPER(inarg)
  79. IF oneflag THEN inarg=LEFT(inarg,1)
  80. inarg=cleanstring(0':'inarg)
  81. IF LENGTH(inarg)>64 THEN
  82.   DO
  83.     SAY 'Question too long!  Please try again.'CR
  84.     inarg=getinput(0 0 pline)
  85.   END
  86. RETURN inarg
  87.  
  88.  
  89. cleanstring:
  90. PARSE ARG nflag':'cstr
  91. bot=TRIM(XRANGE(,' '))
  92. bot=COMPRESS(bot,'1B'x)
  93. top=XRANGE('7F'x)
  94. IF nflag=1 THEN
  95.   DO
  96.     bot=bot||XRANGE('!','@')'[\]`~{:}'
  97.     cstr=TRANSLATE(UPPER(cstr),' ','_')
  98.   END
  99. cstr=COMPRESS(cstr,bot||top)
  100. IF nflag~=2 THEN cstr=STRIP(cstr)
  101. IF nflag=1 THEN cstr=SPACE(cstr,1,'_')
  102. RETURN cstr
  103.  
  104.  
  105. ShowPolls:
  106. SAY CR
  107. totpolls=WORDS(polls)
  108. DO pfl=1 TO totpolls BY 3
  109.   pfl2=pfl+1
  110.   pfl3=pfl+2
  111.   pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(polls,pfl),21)
  112.   IF pfl2<=totpolls THEN
  113.     pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(polls,pfl2),21)
  114.   IF pfl3<=totpolls THEN
  115.     pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(polls,pfl3),21)
  116.   SAY pfline||CR
  117. END
  118. SAY LEFT('=',75,'=')||CR
  119. RETURN
  120.  
  121.  
  122. InitPoll:
  123. SAY CR
  124. SAY 'You are now starting a new list of questions to be answered by other'CR
  125. SAY 'users. You may enter as many multiple-choice questions as you like.'CR
  126. SAY 'You should limit the number of answers per question to 10 or less.'CR
  127. SAY 'Other than that, you are limited only by the bounds of good taste.'CR
  128. SAY 'A ''None Of The Above'' entry will be added to each list of answers.'CR
  129. SAY 'For a simple Yes/No or True/False question just enter one answer (Yes,'CR
  130. SAY 'No, True, False), and the opposite answer will be filled in for you.'CR
  131. SAY CR
  132. u.=''
  133. u.0=0
  134. p.=''
  135. p.0=0
  136. p.0.0=3
  137. n=LASTPOS('_',name)
  138. p.0.0.0='The_'SUBSTR(name,n+1)'_Poll'
  139. DO i=2 WHILE EXISTS(polldir'/'p.0.0.0)
  140.   p.0.0.0=p.0.0.0'_'i
  141. END
  142. p.0.0.0=STRIP(RIGHT(p.0.0.0,20))
  143. p.0.1=DATE('I')
  144. p.0.1.0=name
  145. p.0.2=0
  146. p.0.2.0=p.0.1
  147. p.0.3=0
  148. p.0.3.0=p.0.1
  149. DO i=1
  150.   DO ii=1
  151.     CALL checkBBS()
  152.     SAY CR
  153.     SAY 'Enter Question Number' i '  (or blank to quit)'CR
  154.     SAY '  'LEFT('=',64,'=')||CR
  155.     t=getinput(0 0 '> ')
  156.     IF t='' THEN LEAVE i
  157.     SAY t||CR
  158.     IF getinput(1 1 pen3'Is that correct? (nY) > 'def)~='N' THEN LEAVE ii
  159.   END
  160.   p.i.0.0=t
  161.   DO j=1
  162.     DO jj=1
  163.       SAY 'Enter Answer Number' j '  (or blank to quit)'CR
  164.       t=getinput(0 0 '> ')
  165.       IF t='' THEN LEAVE j
  166.       SAY t||CR
  167.       IF getinput(1 1 pen3'Is that correct? (nY) > 'def)~='N' THEN LEAVE jj
  168.     END
  169.     p.i.j=0
  170.     p.i.j.0=t
  171.   END
  172.   IF j=1 THEN
  173.     DO
  174.       p.i.0=''
  175.       p.i.0.0=''
  176.       LEAVE i
  177.     END
  178.   ELSE IF j=2 THEN
  179.     DO
  180.       IF UPPER(p.i.1.0)='NO' THEN line='Yes'
  181.       ELSE IF UPPER(p.i.1.0)='YES' THEN line='No'
  182.       ELSE IF UPPER(p.i.1.0)='TRUE' THEN line='False'
  183.       ELSE IF UPPER(p.i.1.0)='FALSE' THEN line='True'
  184.       ELSE line='None of the above.'
  185.     END
  186.   ELSE IF j>2 THEN
  187.     DO
  188.       jj=j-1
  189.       IF LEFT(UPPER(p.i.jj),17)='NONE OF THE ABOVE' THEN j=j-1
  190.       line='None of the above.'
  191.     END
  192.   p.i.0=j
  193.   p.i.j=0
  194.   p.i.j.0=line
  195. END
  196. i=i-1
  197. IF i<1 THEN
  198.   DO
  199.     p.=''
  200.     RETURN 1
  201.   END
  202. p.0=i
  203. SAY CR
  204. SAY 'This group of questions is currently called' p.0.0.0||CR
  205. IF getinput(1 1 pen3'Is that correct? (nY) > 'def)='N' THEN
  206.   DO
  207.     SAY 'Please enter a Title, 20 characters or less.'CR
  208.     SAY pen3'  'LEFT('=',20,'=')||def||CR
  209.     t=getinput(0 0 '> ')
  210.     t=COMPRESS(t,xrange(,d2c(31))':/;,`?*='xrange('{')||d2c(34))
  211.     IF t='' THEN t=p.0.0.0
  212.     t=TRANSLATE(t,'_',' ')
  213.     p.0.0.0=t
  214.   END
  215. poll=STRIP(LEFT(p.0.0.0,20))
  216. CALL WritePoll(poll)
  217. polls=SHOWDIR(polldir)
  218. RETURN 0
  219.  
  220.  
  221. do_poll:
  222. IF com<1 | com>WORDS(polls) THEN RETURN
  223. poll=STRIP(WORD(polls,com))
  224. CALL ReadPoll(poll)
  225. IF voted=0 THEN CALL vote()
  226. IF stats() THEN CALL WritePoll(poll)
  227. RETURN
  228.  
  229.  
  230. ReadPoll:
  231. PARSE ARG filename .
  232. CALL CLOSE(f)
  233. x=OPEN(f,polldir'/'filename,'R')
  234. IF x=0 THEN RETURN 1
  235. p.=''
  236. p.0=READLN(f)
  237. IF ~DATATYPE(p.0,'N') THEN RETURN 2
  238. i=0
  239. j=0
  240. DO loop=1
  241.   line=READLN(f)
  242.   IF EOF(f) THEN LEAVE loop
  243.   IF LEFT(line,3)='@@@' THEN
  244.     DO
  245.       IF WORD(line,2)='VOTED' THEN LEAVE loop
  246.       i=i+1
  247.       j=0
  248.       ITERATE loop
  249.     END
  250.   p.i.j=line
  251.   p.i.j.0=READLN(f)
  252.   j=j+1
  253. END
  254. voted=0
  255. u.=''
  256. DO loop=1
  257.   line=READLN(f)
  258.   IF EOF(f) THEN LEAVE loop
  259.   IF name=STRIP(line) THEN voted=1
  260.   u.loop=line
  261. END
  262. CALL CLOSE(f)
  263. IF voted=0 THEN
  264.   DO
  265.     u.0=loop
  266.     u.loop=name
  267.   END
  268. ELSE u.0=loop-1
  269. RETURN 0
  270.  
  271.  
  272. vote:
  273. SAY poll||CR
  274. DO i=1 TO p.0
  275.   SAY pen3'Question:'def p.i.0.0||CR
  276.   IF p.i.0<16 THEN
  277.     DO j=1 TO p.i.0
  278.       SAY pen3||RIGHT(j,7)||def p.i.j.0||CR
  279.     END
  280.   ELSE
  281.     DO pfl=1 TO p.i.0 BY 3
  282.       pfl2=pfl+1
  283.       pfl3=pfl+2
  284.       pfline=pen3||RIGHT(pfl,3)||def LEFT(p.i.pfl.0,21)
  285.       IF pfl2<=p.i.0 THEN
  286.         pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(p.i.pfl2.0,21)
  287.       IF pfl3<=p.i.0 THEN
  288.         pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(p.i.pfl3.0,21)
  289.       SAY pfline||CR
  290.     END
  291.   j=''
  292.   DO WHILE ~DATATYPE(j,'N')
  293.     CALL checkBBS()
  294.     j=getinput(1 0 'Please Select One > ')
  295.     IF j<1 | j>p.i.0 THEN j=''
  296.   END
  297.   p.i.j=p.i.j+1
  298. END
  299. p.0.2=p.0.2+1
  300. p.0.2.0=DATE('I')
  301. RETURN
  302.  
  303.  
  304. stats:
  305. p.0.3=p.0.3+1
  306. p.0.3.0=DATE('I')
  307. SAY CR
  308. SAY CR
  309. SAY pen3'Title:'def poll||CR
  310. SAY CR
  311. temp=p.0.2
  312. IF temp<1 THEN temp=1
  313. DO i=1 TO p.0
  314.   SAY p.i.0.0||CR
  315.   IF p.i.0<16 THEN
  316.     DO j=1 TO p.i.0
  317.       SAY RIGHT(TRUNC(.05+(p.i.j*100)/temp,1),6)'%  'p.i.j.0||CR
  318.     END
  319.   ELSE
  320.     DO pfl=1 TO p.i.0 BY 3
  321.       pfl2=pfl+1
  322.       pfl3=pfl+2
  323.       pfline=RIGHT(TRUNC(.05+(p.i.pfl*100)/temp,1),4)'% 'LEFT(p.i.pfl.0,19)
  324.       IF pfl2<=p.i.0 THEN
  325.         pfline=pfline RIGHT(TRUNC(.05+(p.i.pfl2*100)/temp,1),4)'% 'LEFT(p.i.pfl2.0,19)
  326.       IF pfl3<=p.i.0 THEN
  327.         pfline=pfline RIGHT(TRUNC(.05+(p.i.pfl3*100)/temp,1),4)'% 'LEFT(p.i.pfl3.0,19)
  328.       SAY pfline||CR
  329.     END
  330.   SAY CR
  331.   CALL getinput(1 1 'Press Return ')
  332.   SAY lineup'                      'lineup||CR
  333. END
  334. SAY poll 'originated by' p.0.1.0 DATE(,p.0.1,'I')||CR
  335. SAY 'This survey has been running' 1+DATE('I')-p.0.1 'days.'CR
  336. SAY p.0.2 'users have responded and the statistics have been read' p.0.3 'times.'CR
  337. SAY CR
  338. IF name=p.0.1.0 | name=sysop THEN
  339.   DO
  340.     temp=''
  341.     IF name=p.0.1.0 THEN temp='This one owned by you. '
  342.     temp=temp'Do you want to delete this poll? (Ny) > '
  343.     IF getinput(1 1 temp)='Y' THEN
  344.       DO
  345.         CALL bbsNewFile.rexx(name polldir'/'p.0.0.0)
  346.         CALL DELETE(polldir'/'p.0.0.0)
  347.         SAY p.0.0.0 'deleted.'CR
  348.         SAY CR
  349.         polls=SHOWDIR(polldir)
  350.         RETURN 0
  351.       END
  352.     SAY CR
  353.   END
  354. ELSE CALL getinput(1 1 'Press Return ')
  355. RETURN 1
  356.  
  357.  
  358. WritePoll:
  359. PARSE ARG filename .
  360. CALL CLOSE(f)
  361. x=OPEN(f,polldir'/'filename,'W')
  362. IF x=0 THEN RETURN 1
  363. DO i=0 TO p.0
  364.   IF i=0 THEN CALL WRITELN(f,p.0)
  365.   ELSE CALL WRITELN(f,'@@@' i)
  366.   DO j=0 TO p.i.0
  367.     CALL WRITELN(f,p.i.j)
  368.     CALL WRITELN(f,STRIP(p.i.j.0))
  369.   END
  370. END
  371. CALL WRITELN(f,'@@@ VOTED')
  372. IF ~DATATYPE(u.0,'N') THEN u.0=0
  373. DO i=1 TO u.0
  374.   CALL WRITELN(f,u.i)
  375. END
  376. CALL CLOSE(f)
  377. RETURN 0
  378.  
  379.  
  380. colors:
  381. ARG onoff
  382. IF onoff THEN
  383.   DO
  384.     lineup='1B'x'M'
  385.     def='';  /* default */
  386.     pen0='';  pen1='';  pen2='';  pen3=''
  387.     pen4='';  pen5='';  pen6='';  pen7=''
  388.     bak0='';  bak1='';  bak2='';  bak3=''
  389.     bak4='';  bak5='';  bak6='';  bak7=''
  390.   END
  391. ELSE
  392.   DO
  393.     pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
  394.     bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
  395.     def='';  lineup=''
  396.   END
  397. RETURN
  398.  
  399.  
  400. BREAK_C:
  401. BREAK_E:
  402. CALL CLOSE(f)
  403. EXIT
  404.  
  405.  
  406. /*
  407. Data Format  (Dates in internal format)
  408.  
  409. p.0        Total Questions in this survey
  410. p.0.0      "3"
  411. p.0.0.0    Overall Survey Title (also filename)
  412. p.0.1      Date this survey started.
  413. p.0.1.0    Survey Originated By
  414. p.0.2      Total users polled in this survey.
  415. p.0.2.0    Date the last user was polled in this survey.
  416. p.0.3      Total users reading responses to this survey.
  417. p.0.3.0    Date the last user read responses to this survey.
  418. "@@@ 1"      
  419. p.1.0      Total possible responses to Question 1
  420. p.1.0.0    Question 1
  421. p.1.1      Response 1 Total
  422. p.1.1.0    Response 1 Text
  423. p.1.2      Response 2 Total
  424. p.1.2.0    Response 2 Text
  425. ...
  426. p.1.n      Response n-3 Total
  427. p.1.n.0    Response n-3 Text
  428. "@@@ 2"
  429. p.2.0      Total possible responses to Question 2
  430. p.2.0.0    Question 2
  431. p.2.1      Response 1 Total
  432. p.2.1.0    Response 1 Text
  433. p.2.2      Response 2 Total
  434. p.2.2.0    Response 2 Text
  435.        etc.
  436. "@@@ VOTED"
  437. u.1        first user polled
  438. ...        list of users who have responded to this survey.
  439. u.[p.0.2]  last user polled
  440. */
  441.  
  442. /* Polling_Place.rexx */
  443.